home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / leastsq.src < prev    next >
Text File  |  1992-01-02  |  3KB  |  103 lines
  1. %%HP:T(3)A(D)F(.);
  2. @ LEASTSQ by Anthony K. Donno
  3. DIR
  4.   LEAST
  5.     \<< DELEQ CL\GS \GS+ CLLCD 1 'XC' STO 2 'YC' STO 3 'ORDR' STO XYR
  6.       { { "XCOL" {
  7.       \<< 'XC' STO DELEQ XYR
  8.       \>>
  9.       \<< 'XC' STO DELEQ XYR
  10.       \>>
  11.       \<< XC XYR
  12.       \>> } } { "YCOL" {
  13.       \<< 'YC' STO DELEQ XYR
  14.       \>>
  15.       \<< 'YC' STO DELEQ XYR
  16.       \>>
  17.       \<< YC XYR
  18.       \>> } } { "ORDER" {
  19.       \<< 'ORDR' STO DELEQ XYR
  20.       \>>
  21.       \<< 'ORDR' STO DELEQ XYR
  22.       \>>
  23.       \<< ORDR XYR
  24.       \>> } } { "PLOT"
  25.       \<<
  26.         IF 'EQ' VTYPE -1 ==
  27.         THEN SETRNG FIT
  28.         END
  29.         IF 'EQ' VTYPE 2 ==
  30.         THEN EQ 1 DISP 2 WAIT
  31.         ELSE FUNCTION PLOT GRAPH
  32.         END XYR
  33.       \>> } { "FIT"
  34.       \<<
  35.         IF 'EQ' VTYPE -1 ==
  36.         THEN FIT
  37.         END
  38.         IF 'EQ' VTYPE 2 ==
  39.         THEN EQ 1 DISP 2 WAIT
  40.         ELSE 'EQ' RCL
  41.         END XYR
  42.       \>> } { "EXIT"
  43.       \<< 0 MENU
  44.       \>> } } TMENU
  45.     \>>
  46.   PLOT
  47.     \<< ERASE \GSDAT SIZE OBJ\-> DROP DROP \-> d
  48.       \<< 1 d
  49.         FOR i \GSDAT i XC 2 \->LIST GET \GSDAT i YC 2 \->LIST GET R\->C C\->PX
  50.           PIXON
  51.         NEXT DRAX DRAW
  52.       \>>
  53.     \>>
  54.   FIT
  55.     \<< \GSDAT SIZE OBJ\-> DROP DROP \-> d
  56.       \<<
  57.         IF d ORDR >
  58.         THEN d ORDR 1 + 2 \->LIST 1 CON 2 ORDR 1 +
  59.           FOR i 1 d
  60.             FOR j j i 2 \->LIST \GSDAT j XC 2 \->LIST GET i 1 - ^ PUT
  61.             NEXT
  62.           NEXT 1 d
  63.           FOR i \GSDAT i YC 2 \->LIST GET
  64.           NEXT d 1 2 \->LIST \->ARRY SWAP DUP DUP TRN SWAP * INV SWAP TRN *
  65.           SWAP * OBJ\-> DROP ORDR POLY
  66.         ELSE "ERROR: Order > Points\010______________________"
  67.         END 'EQ' STO
  68.       \>>
  69.     \>>
  70.   POLY
  71.     \<< \-> d
  72.       \<< -3 CF 'X' d ^ * d 1 - 0
  73.         FOR d SWAP 'X' d ^ * + -1
  74.         STEP
  75.       \>>
  76.     \>>
  77.   SETRNG
  78.     \<< MAX\GS XC GET MAX\GS YC GET \-> xmax ymax
  79.       \<< MIN\GS XC GET MIN\GS YC GET \-> xmin ymin
  80.         \<< xmax xmin XRNG ymax ymin YRNG
  81.         \>>
  82.       \>>
  83.     \>>
  84.   XYR
  85.     \<< RCLF \-> flags
  86.       \<< -45 CF -46 CF -47 CF -48 CF -49 CF -50 CF "Xcol:" XC \->STR +
  87.         " Ycol:" + YC \->STR + " Order:" + ORDR \->STR +
  88.         "\010______________________" + 1 DISP 1 FREEZE flags STOF
  89.       \>>
  90.     \>>
  91.   DELEQ
  92.     \<<
  93.       IF 'EQ' VTYPE -1 \=/
  94.       THEN 'EQ' PURGE
  95.       END
  96.     \>>
  97.   CST { LEAST PLOT FIT { } { "PURGE"
  98.     \<< { EQ PPAR ORDR YC XC \GSDAT } PURGE
  99.     \>> } { "EXIT"
  100.     \<< HOME
  101.     \>> } }
  102. END
  103.